home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / pibcat.zip / PIBCATL.PAS < prev    next >
Pascal/Delphi Source File  |  1989-04-01  |  12KB  |  280 lines
  1. (*----------------------------------------------------------------------*)
  2. (*   Display_Lbr_Contents --- Display contents of library (.LBR) file   *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Display_Lbr_Contents( LbrFileName : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*    Procedure: Display_Lbr_Contents                                   *)
  10. (*                                                                      *)
  11. (*    Purpose:   Displays contents of a library file (.LBR file)        *)
  12. (*                                                                      *)
  13. (*    Calling sequence:                                                 *)
  14. (*                                                                      *)
  15. (*       Display_Lbr_Contents( LbrFileName : AnyStr );                  *)
  16. (*                                                                      *)
  17. (*          LbrFileName --- name of library file whose contents         *)
  18. (*                          are to be listed.                           *)
  19. (*                                                                      *)
  20. (*    Calls:                                                            *)
  21. (*                                                                      *)
  22. (*       Aside from internal subroutines, these routines are required:  *)
  23. (*                                                                      *)
  24. (*          Dir_Convert_Date_And_Time                                   *)
  25. (*                            --- convert DOS packed date/time to string*)
  26. (*          Open_File         --- open a file                           *)
  27. (*          Close_File        --- close a file                          *)
  28. (*          Entry_Matches     --- Perform wildcard match                *)
  29. (*          Display_Page_Titles                                         *)
  30. (*                            --- Display titles at top of page         *)
  31. (*          DUPL              --- Duplicate a character into a string   *)
  32. (*                                                                      *)
  33. (*----------------------------------------------------------------------*)
  34.  
  35. (*----------------------------------------------------------------------*)
  36. (*              Map of Library file (.LBR) entry header                 *)
  37. (*----------------------------------------------------------------------*)
  38.  
  39. TYPE
  40.    Lbr_Entry_Type = RECORD
  41.                        Flag  : BYTE                   (* LBR - Entry flag           *);
  42.                        Name  : ARRAY[1 .. 8] OF CHAR  (* File name                  *);
  43.                        Ext   : ARRAY[1 .. 3] OF CHAR  (* Extension                  *);
  44.                        Offset: WORD                   (* Offset within Library      *);
  45.                        N_Sec : WORD                   (* Number of 128-byte sectors *);
  46.                        CRC   : WORD                   (* CRC (optional)             *);
  47.                        Date  : WORD                   (* # days since 1/1/1978      *);
  48.                        UDate : WORD                   (* Date of last update        *);
  49.                        Time  : WORD                   (* Packed time                *);
  50.                        UTime : WORD                   (* Time of last update        *);
  51.                        Pads  : ARRAY[1 .. 6] OF CHAR  (* Currently unused           *);
  52.                     END;
  53.  
  54. CONST
  55.    Lbr_Header_Length = 32          (* Length of library file header entry   *);
  56.  
  57. VAR
  58.    LbrFile       : FILE            (* Library file                          *);
  59.    Lbr_Entry     : Lbr_Entry_Type  (* Header describing one file in library *);
  60.    Lbr_Pos       : LONGINT         (* Current byte position in library      *);
  61.    Lbr_Dir_Size  : INTEGER         (* # of entries in library directory     *);
  62.    Bytes_Read    : INTEGER         (* # bytes read at current file position *);
  63.    Ierr          : INTEGER         (* Error flag                            *);
  64.    Long_Name     : AnyStr          (* Long file name                        *);
  65.  
  66. (*----------------------------------------------------------------------*)
  67. (*      Get_Next_Lbr_Entry --- Get next header entry in library         *)
  68. (*----------------------------------------------------------------------*)
  69.  
  70. FUNCTION Get_Next_Lbr_Entry( VAR Lbr_Entry : Lbr_Entry_Type;
  71.                              VAR Error     : INTEGER ) : BOOLEAN;
  72.  
  73. VAR
  74.    Month : INTEGER;
  75.    Year  : INTEGER;
  76.    Done  : BOOLEAN;
  77.    T     : INTEGER;
  78.                                    (* # of days in each month *)
  79. (* STRUCTURED *) CONST
  80.    NDays : ARRAY[1..12] OF INTEGER = ( 31, 28, 31, 30, 31, 30,
  81.                                        31, 31, 30, 31, 30, 31  );
  82.  
  83. BEGIN (* Get_Next_Lbr_Entry *)
  84.                                    (* Assume no error *)
  85.    Error := 0;
  86.                                    (* Loop over directory entries *)
  87.    REPEAT
  88.                                    (* Decrement directory entry count. *)
  89.                                    (* If = 0, reached end of directory *)
  90.                                    (* entries.                         *)
  91.  
  92.       Lbr_Dir_Size := PRED( Lbr_Dir_Size );
  93.       IF ( Lbr_Dir_Size < 0 ) THEN
  94.          Error := End_Of_File;
  95.                                    (* If not end of entries ... *)
  96.       IF ( Error = 0 ) THEN
  97.          BEGIN
  98.                                    (* If not first time, move to next   *)
  99.                                    (* directory entry position in file. *)
  100.  
  101.             IF ( Lbr_Pos <> 0 ) THEN
  102.                Seek( LbrFile, Lbr_Pos );
  103.  
  104.                                    (* Read directory entry *)
  105.  
  106.             BlockRead( LbrFile, Lbr_Entry, SizeOf( Lbr_Entry ), Bytes_Read );
  107.             Error := 0;
  108.                                    (* If wrong length, .LBR format must *)
  109.                                    (* be incorrect.                     *)
  110.  
  111.             IF ( Bytes_Read < Lbr_Header_Length ) THEN
  112.                Error := Format_Error
  113.             ELSE
  114.                                    (* If length OK, assume entry OK. *)
  115.                WITH Lbr_Entry DO
  116.                   BEGIN
  117.                                    (* Point to next .LBR entry in file *)
  118.  
  119.                      Lbr_Pos := Lbr_Pos + Lbr_Header_Length;
  120.  
  121.                                    (* Pick up time/date of creation this *)
  122.                                    (* entry if specified.  If the update *)
  123.                                    (* time/date is different, then we    *)
  124.                                    (* will report that instead.          *)
  125.  
  126.                      IF ( Time = 0 ) THEN
  127.                         BEGIN
  128.                            Time := UTime;
  129.                            Date := UDate;
  130.                         END
  131.                      ELSE
  132.                         IF ( ( Time <> UTime ) OR ( Date <> UDate ) ) THEN
  133.                            BEGIN
  134.                               Time := UTime;
  135.                               Date := UDate;
  136.                            END;
  137.                                    (* Convert date from library format of *)
  138.                                    (* # days since 1/1/1978 to DOS format *)
  139.                      Month := 1;
  140.                      Year  := 78;
  141.                                    (* This is done using brute force. *)
  142.                      REPEAT
  143.                                    (* Account for leap years *)
  144.  
  145.                         T    := 365 + ORD( Year MOD 4 = 0 );
  146.  
  147.                                    (* See if we have less than 1 year left *)
  148.  
  149.                         Done := ( Date < T );
  150.  
  151.                         IF ( NOT Done ) THEN
  152.                            BEGIN
  153.                               Year := SUCC( Year );
  154.                               Date := Date - T;
  155.                            END;
  156.  
  157.                      UNTIL Done;
  158.                                    (* Now get months and days within year *)
  159.                      REPEAT
  160.  
  161.                         T    := Ndays[Month] +
  162.                                 ORD( ( Month = 2 ) AND ( Year MOD 4 = 0 ) );
  163.  
  164.                         Done := ( Date < T );
  165.  
  166.                         IF ( NOT Done ) THEN
  167.                            BEGIN
  168.                               Month := SUCC( Month );
  169.                               Date  := Date - T;
  170.                            END;
  171.  
  172.                      UNTIL Done;
  173.                                    (* If > 1980, convert to DOS date *)
  174.                                    (* else leave unconverted.        *)
  175.  
  176.                      IF ( Year >= 80 ) THEN
  177.                         Date := ( Year - 80 ) SHL 9 + Month SHL 5 + Date
  178.                      ELSE
  179.                         Date := 0;
  180.  
  181.                   END (* With *);
  182.  
  183.          END   (* Error = 0 *);
  184.  
  185.    UNTIL ( ( Error <> 0 ) OR ( Lbr_Entry.Flag = 0 ) );
  186.  
  187.                                    (* Report success/failure to caller *)
  188.  
  189.    Get_Next_Lbr_Entry := ( Error = 0 );
  190.  
  191. END   (* Get_Next_Lbr_Entry *);
  192.  
  193. (*----------------------------------------------------------------------*)
  194. (*      Display_Lbr_Entry --- Display .LBR entry file data              *)
  195. (*----------------------------------------------------------------------*)
  196.  
  197. PROCEDURE Display_Lbr_Entry( Lbr_Entry : Lbr_Entry_Type );
  198.  
  199. VAR
  200.    FName      : AnyStr;
  201.    RLength    : LONGINT;
  202.    TimeDate   : LONGINT;
  203.    TimeDateW  : ARRAY[1..2] OF WORD ABSOLUTE TimeDate;
  204.  
  205. BEGIN (* Display_Lbr_Entry *)
  206.  
  207.    WITH Lbr_Entry DO
  208.       BEGIN
  209.                                    (* Pick up file name *)
  210.          FName := TRIM( Name );
  211.  
  212.          IF ( Ext <> '   ' ) THEN
  213.             FName   := FName + '.' + Ext;
  214.  
  215.                                    (* See if this file matches the   *)
  216.                                    (* entry spec wildcard.  Exit if  *)
  217.                                    (* not.                           *)
  218.  
  219.          IF Use_Entry_Spec THEN
  220.             IF ( NOT Entry_Matches( FName ) ) THEN
  221.                EXIT;
  222.                                    (* Convert length in sectors to *)
  223.                                    (* length in bytes.             *)
  224.          RLength := N_Sec * 128;
  225.  
  226.                                    (* Get date and time of creation *)
  227.          TimeDateW[ 1 ] := Time;
  228.          TimeDateW[ 2 ] := Date;
  229.  
  230.          Long_Name      := '';
  231.  
  232.                                    (* Display info for this entry *)
  233.  
  234.          Display_One_Entry( FName, Rlength, TimeDate, LbrFileName,
  235.                             Current_Subdirectory, Long_Name );
  236.  
  237.       END;
  238.  
  239. END (* Display_Lbr_Entry *);
  240.  
  241. (*----------------------------------------------------------------------*)
  242.  
  243. BEGIN (* Display_Lbr_Contents *)
  244.  
  245.                                    (* Open "lbr" library file and  *)
  246.                                    (* initialize contents display. *)
  247.  
  248.    IF Start_Contents_Listing( ' LBR file: ',
  249.                               Current_Subdirectory + LbrFileName, LbrFile,
  250.                               Lbr_Pos, Ierr ) THEN
  251.       BEGIN
  252.  
  253.                                    (* Set # directory entries = 1 so   *)
  254.                                    (* we can process actual directory. *)
  255.          Lbr_Dir_Size := 1;
  256.                                    (* Pick up actual number of entries *)
  257.                                    (* in library.                      *)
  258.  
  259.          IF ( Get_Next_Lbr_Entry( Lbr_Entry , Ierr ) ) THEN
  260.             WITH Lbr_Entry DO
  261.                IF ( ( ( Flag OR Offset ) = 0 ) AND ( N_Sec <> 0 ) ) THEN
  262.                   Lbr_Dir_Size := PRED( N_Sec * 4 )
  263.                ELSE
  264.                   Ierr := Format_Error;
  265.  
  266.                                    (* Loop over library entries and print *)
  267.                                    (* information about each entry.       *)
  268.  
  269.          IF ( Ierr = 0 ) THEN
  270.             WHILE( Get_Next_Lbr_Entry( Lbr_Entry , Ierr ) ) DO
  271.                Display_Lbr_Entry( Lbr_Entry );
  272.  
  273.                                    (* Close library file *)
  274.  
  275.          End_Contents_Listing( LbrFile , Ierr );
  276.  
  277.       END;
  278.  
  279. END   (* Display_Lbr_Contents *);
  280.